unit alSQLParser;

interface

uses
  Windows, Classes, SysUtils, DB, WideStrUtils;

type
  TBaseSQLToken = (stUnknown, stTableName, stFieldName, stAs,
    stAscending, stDescending, stSelect, stFrom, stWhere,
    stInnerJoin, stLeftOuterJoin, stRightOuterJoin, stFullOuterJoin, stOn,
    stGroupBy, stHaving, stUnion, stPlan, stOrderBy, stForUpdate,
    stEnd, stPredicate, stValue, stFunction,
    stIsNull, stIsNotNull, stLike, stNotLike, stBetween, stNotBetween, stIn, stNotIn,
    stContaining, stNotContaining, stStarting, stNotStarting, stExists,
    stNot, stAnd, stOr, 
    stNumber, stAllFields, stComment, stDistinct);

  TSQLParser = class(TPersistent)
  private
    FCurContext: TBaseSQLToken;
  protected

  public
    constructor Create;
    function NextSQLToken(var p: PChar; out Token: string; CurSection: TBaseSQLToken = stUnknown): TBaseSQLToken;
    function AddSQLWhere(SQL: string; SQLWhere: string): string;
    property CurContext: TBaseSQLToken read FCurContext;
  end;

const
  SQLSections = [stSelect, stFrom, stWhere, stInnerJoin, stLeftOuterJoin, stRightOuterJoin, 
    stGroupBy, stHaving, stUnion, stPlan, stOrderBy, stForUpdate];

implementation

function TSQLParser.AddSQLWhere(SQL, SQLWhere: string): string;
const
  SWhere = ' where ';     { do not localize }
  SAnd = ' and ';         { do not localize }

  function AddWhereClause: string;
  var
    Start: PChar;
    Rest, FName: string;
    SQLToken, CurSection: TBaseSQLToken;
    SToken: string;
    HasWhere: Boolean;
  begin
    Start := PChar(SQL);
    CurSection := stUnknown;
    HasWhere := False;
    repeat
      SQLToken := NextSQLToken(Start, FName, CurSection);
      if (SQLToken = stWhere) and (HasWhere = False) then
        HasWhere := True;
    until SQLToken in [stGroupBy, stHaving, stUnion, stOrderBy, stEnd];
    Rest := string(Start);
    if HasWhere then
      SToken := SAnd
    else
      SToken := SWhere;
    if Rest = '' then
      Result := Trim(SQL) + ' ' + SToken + Trim(SQLWhere)
    else
      Result := Trim(Copy(SQL, 1, Pos(Rest, SQL))) + ' ' + SToken + Trim(SQLWhere) + ' ' + Rest;
  end;

begin
  Result := AddWhereClause;
end;

constructor TSQLParser.Create;
begin
  inherited;
  FCurContext := stUnknown;
end;

function TSQLParser.NextSQLToken(var p: PChar; out Token: string; CurSection: TBaseSQLToken = stUnknown): TBaseSQLToken;
var
  DotStart: Boolean;

  function NextTokenIs(Value: string; var Str: string): Boolean;
  var
    Tmp: PChar;
    S: string;
  begin
    Tmp := p;
    NextSQLToken(Tmp, S, CurSection);
    Result := CompareText(Value, S) = 0;
    if Result then
    begin
      Str := Str + ' ' + S;
      p := Tmp;
    end;
  end;

  function GetSQLToken(var Str: string): TBaseSQLToken;
  var
    ACurContext: TBaseSQLToken;
  begin
    if CurSection = stUnknown then
      ACurContext := FCurContext
    else
      ACurContext := CurSection;
    if Length(Str) = 0 then
      Result := stEnd else
    if CompareText('SELECT', Str) = 0 then
      Result := stSelect else
    if (CompareText('DISTINCT', Str) = 0) and (ACurContext = stSelect) then
      Result := stDistinct else
    if (Str = '*') and (ACurContext = stSelect) then
      Result := stAllFields else
    if DotStart then
      Result := stFieldName else
    if (CompareText('AS', Str) = 0) then // Change
      Result := stAs else
    if CompareText('FROM', Str) = 0 then
      Result := stFrom else
    if (CompareText('JOIN', Str) = 0) or // Change
      ((CompareText('INNER', Str) = 0) and NextTokenIs('JOIN', Str)) then
      Result := stInnerJoin else
    if (CompareText('LEFT', Str) = 0) and // Change
      (NextTokenIs('JOIN', Str) or (NextTokenIs('OUTER', Str) and NextTokenIs('JOIN', Str))) then
      Result := stLeftOuterJoin else
    if (CompareText('RIGHT', Str) = 0) and // Change
      (NextTokenIs('JOIN', Str) or (NextTokenIs('OUTER', Str) and NextTokenIs('JOIN', Str))) then
      Result := stRightOuterJoin else
    if (CompareText('FULL', Str) = 0) and // Change
      (NextTokenIs('JOIN', Str) or (NextTokenIs('OUTER', Str) and NextTokenIs('JOIN', Str))) then
      Result := stFullOuterJoin else
    if CompareText('ON', Str) = 0 then // Change
      Result := stOn else
    if CompareText('WHERE', Str) = 0 then
      Result := stWhere else
    if CompareText('BETWEEN', Str) = 0 then
      Result := stBetween else
    if CompareText('LIKE', Str) = 0 then
      Result := stLike else
    if CompareText('IN', Str) = 0 then
      Result := stIn else
    if CompareText('EXISTS', Str) = 0 then
      Result := stExists else
    if CompareText('CONTAINING', Str) = 0 then
      Result := stContaining else
    if (CompareText('STARTING', Str) = 0) or
      ((CompareText('STARTING', Str) = 0) and (NextTokenIs('WITH', Str))) then
      Result := stStarting else
    if CompareText('NOT', Str) = 0 then
    begin
      if NextTokenIs('LIKE', Str) then
        Result := stNotLike else
      if NextTokenIs('BETWEEN', Str) then
        Result := stNotBetween else
      if NextTokenIs('IN', Str) then
        Result := stNotIn else
      if NextTokenIs('CONTAINING', Str) then
        Result := stNotContaining else
      if NextTokenIs('STARTING', Str) or
        (NextTokenIs('STARTING', Str) and NextTokenIs('WITH', Str)) then
        Result := stStarting
      else
        Result := stNot;
    end else
    if CompareText('AND', Str) = 0 then
      Result := stAnd else
    if CompareText('OR', Str) = 0 then
      Result := stOr else
    if (CompareText('IS', Str) = 0) then
    begin
      if NextTokenIs('NULL', Str) then
        Result := stIsNull else
      if NextTokenIs('NOT', Str) and NextTokenIs('NULL', Str) then
        Result := stIsNotNull;
    end else
    if (CompareText('SUM', Str) = 0) or (CompareText('AVG', Str) = 0) or
      (CompareText('MAX', Str) = 0) or (CompareText('MIN', Str) = 0) or
      (CompareText('CAST', Str) = 0) or (CompareText('UPPER', Str) = 0) or
      (CompareText('SUBSTR', Str) = 0) then
      Result := stFunction else
    if (CompareText('GROUP', Str) = 0) and NextTokenIs('BY', Str) then
      Result := stGroupBy else
    if CompareText('HAVING', Str) = 0 then
      Result := stHaving else
    if CompareText('UNION', Str) = 0 then
      Result := stUnion else
    if CompareText('PLAN', Str) = 0 then
      Result := stPlan else
    if (CompareText('FOR', Str) = 0) and NextTokenIs('UPDATE', Str) then
      Result := stForUpdate else
    if (CompareText('ORDER', Str) = 0) and NextTokenIs('BY', Str)  then
      Result := stOrderBy else
    if (CompareText('ASC', Str) = 0) or (CompareText('ASCENDING', Str) = 0) then
      Result := stAscending else
    if (CompareText('DESC', Str) = 0) or (CompareText('DESCENDING', Str) = 0) then
      Result := stDescending else
    if CompareText('NULL', Str) = 0 then
      Result := stValue else
    if (ACurContext = stFrom) or (ACurContext = stInnerJoin) or
      (ACurContext = stLeftOuterJoin) or (ACurContext = stRightOuterJoin)
      or (ACurContext = stFullOuterJoin) then
      Result := stTableName
    else
      Result := stFieldName;
    if Result in SQLSections then
      FCurContext := Result;
  end;

var
  TokenStart: PChar;

  procedure StartToken;
  begin
    if not Assigned(TokenStart) then
      TokenStart := p;
  end;

var
  Literal: Char;
  Mark: PChar;
begin
  TokenStart := nil;
  DotStart := False;
  while True do
  begin
    case p^ of
      '"','''','`':
      begin
        StartToken;
        Literal := p^;
        Mark := p;
        //repeat Inc(p) until (p^ in [Literal, #0]);
        repeat Inc(p) until (inOpArray(p^, [Literal, #0])); //Changed
        if p^ = #0 then
        begin
          p := Mark;
          Inc(p);
        end else
        begin
          Inc(p);
          SetString(Token, TokenStart, p - TokenStart);
          Mark := PChar(Token);
          Token := AnsiExtractQuotedStr(Mark, Literal);
          if DotStart then
            Result := stFieldName else
          if p^ = '.' then
            Result := stTableName else
            Result := stValue;
          Exit;
        end;
      end;
      '/':
      begin
        StartToken;
        Inc(p);
        //if p^ in  ['/','*'] then
        if inOpSet(p^, ['/','*']) then // Changed
        begin
          if p^ = '*' then
          begin
            repeat Inc(p) until (p^ = #0) or ((p^ = '*') and (p[1] = '/'));
          end else
            //while not (p^ in  [#0, #10, #13]) do Inc(p);
            while not (inOpSet(p^, [#0, #10, #13])) do Inc(p); // Changed
          SetString(Token, TokenStart, p - TokenStart);
          Result := stComment;
          Exit;
        end;
      end;
      ' ', #10, #13, ',', '(', ')', ';': // Change ')'
      begin
        if Assigned(TokenStart) then
        begin
          SetString(Token, TokenStart, p - TokenStart);
          Result := GetSQLToken(Token);
          Exit;
        end else
          //while (p^ in [' ', #10, #13, ',', '(', ')', ';']) do Inc(p);
          while (inOpSet(p^, [' ', #10, #13, ',', '(', ')', ';'])) do Inc(p); // Change ')'
      end;
      '.':
      begin
        if Assigned(TokenStart) then
        begin
          SetString(Token, TokenStart, p - TokenStart);
          Result := stTableName;
          Exit;
        end else
        begin
          DotStart := True;
          Inc(p);
        end;
      end;
      '=','<','>':
      begin
        if not Assigned(TokenStart) then
        begin
          TokenStart := p;
          //while p^ in  ['=','<','>'] do Inc(p);
          while inOpSet(p^, ['=','<','>']) do Inc(p); // Changed
          SetString(Token, TokenStart, p - TokenStart);
          Result := stPredicate;
          Exit;
        end;
        Inc(p);
      end;
      '0'..'9':
      begin
        if not Assigned(TokenStart) then
        begin
          TokenStart := p;
          //while p^ in ['0'..'9','.'] do Inc(p);
          while inOpSet(p^, ['0'..'9','.']) do Inc(p); // Changed
          SetString(Token, TokenStart, p - TokenStart);
          Result := stNumber;
          Exit;
        end else
          Inc(p);
      end;
      #0:
      begin
        if Assigned(TokenStart) then
        begin
          SetString(Token, TokenStart, p - TokenStart);
          Result := GetSQLToken(Token);
          Exit;
        end else
        begin
          Result := stEnd;
          Token := '';
          Exit;
        end;
      end;
    else
      StartToken;
      Inc(p);
    end;
  end;
end;

end.
